MACD 5/MACD 5.bin/internet/yam_i_dodatki/yamscripts/wholestory.rexx

OS/2 REXX Batch file | 1997-07-22 | 5KB | 202 lines

/*
** WholeStory.rexx 1.4 - 15-Mar-96 by [e-mail]
**
** I belong to a X-Files fanfic mailing list and long stories are usually posted
** in parts.  This script will find and join all parts.
**
** New in 1.4
**  -creates a better filename
**  -returns to the correct message, even when aborted
**  -one bug removed which caused sometimes an error                                                                                                                                            xs
** New in 1.3:
**  -now hadles both (n/m) and n/m numbering correctly
** New in 1.2:
**  -script now displays a requester with message subjects
**  -messages are marked deleted AFTER they have been copied to the file
**  -an end message tells you when everything is done
** Send all comments, bug reports, suggestions and X-mas cards to [e-mail]
*/

options results
call addlib('rexxsupport.library',0,-30)
call addlib('rexxreqtools.library',0,-30)

 defdir='work:home'
  qbody='How similar the subjects need to be?'
  qbuts='_Very|_Quite|_Cancel'
   body='I found these parts in this order:'
buttons='_Save them|_Quit'
  title='WholeStory 1.2 © [e-mail]'
   tags='rt_pubscrname=YAMSCREEN'  /* Change here the name of the screen YAM runs */
mc=0
used=0
NL='0a'x

address 'YAM'
'GetMailInfo From'
server=result
'GetMailInfo Subject'
subj=result
'GetMailInfo Active'
active=result
'GetFolderInfo Max'
n=result
maxdif=rtezrequest(qbody,qbuts,title,'rtez_defaultresponse=1' tags)*2-1
if maxdif=0 then exit
/*
** First scan all messages in the folder.
** Search for messages with same sender and at most 4 different chars in subject
*/

do m=0 to n-1
    'SetMail' m
    'GetMailInfo From'
    if result=server then do
       'GetMailInfo Subject'
       if SubDiff(upper(result),upper(subj))<=maxdif then do
               call AddMsg(result)
        part.mc=m
        end
    end /* if result=server then do */
end /* do m=1 to n */
'SetMail' active  /* Go back to the originally selected message */

/*
** Then sort the messages.  Hopefully part 10 comes after 9 and not after 1....
*/

call SortMessages

/*
** Do you really want to save them?
*/
do i=1 to mc
    body=body NL subject.i
    end

sel=rtezrequest(body,buttons,title,'rtez_defaultresponse=1' tags)
if sel=0 then exit

/*
** Lets write the messages into one file
*/
storyname=compress(subject.1,',/:()*<>[]"0123456789')
if upper(left(storyname,3))='NEW' then storyname=substr(storyname,4)
if upper(left(storyname,6))='REPOST' then storyname=substr(storyname,7)
storyname=strip(left(storyname,25,''))
storyname=translate(storyname,'_',' ')
outfile=rtfilerequest(defdir,storyname,'Select story name' tags)
if outfile='' then exit

call open(out,outfile,'w')
call writeln(out,'This file contains the following messages:')
do i=1 to mc
        call writeln(out,subject.i)
        end /* do i=1 to mc */
call writeln(out,'')
address 'YAM'
do i=1 to mc
        if ~open(inp,filename.i,'r') then do
        'Request "Can not read part*n'subject.i'" "Ok"'
        'SetMail' active  /* Go back to the originally selected message */
        exit
        end
    do until eof(inp) | r='' /* Skip headers */
        r=readln(inp)
        end
    do until eof(inp)
        r=readln(inp)
        call writeln(out,r)
        end
    call close(inp)
    'SetMail' part.i
    'MailDelete'
        end /* do i=1 to mc */
call close(out)
'Request "All parts are saved and marked as deleted!" "_Ok"'

exit    /* It's the end of the script as we know it... */

FindStart:
  found_it=0
  if used=0 then do
  /*
  ** When called the first time, this branch checks which delimiters are used
  ** Following calls use else branch
  */
     do until eof(1) | found_it
         rivi=readln(1)
         do d=1 to delimiters
             if pos(startline.d,rivi)=1 then do
              found_it=1
              used=d
          end /* if */
              end /* do d=1 */
         end /*do until */
     if used=3 then call writeln(tmp,rivi)  /* Save uuencode first line */
     end /* ifused=0 */
  else do
     do until eof(1) | found_it
         rivi=readln(1)
         found_it=pos(startline.used,rivi)
         end /*do until */
     end /* else do */
return found_it

SubDiff: procedure
  /* Differences between strings are calculate by word */
  parse arg s1,s2
  diff=0
  do i=1 to words(s1)
    diff=diff+ (word(s1,i)~=word(s2,i))
  end
return diff


AddMsg:
/*
** This changes the subject's (1/n) to (01/n) to allow sorting
*/
  parse arg s
  mc=mc+1
  bra=lastpos('(',s)
  if bra>0 then do
      slash=pos('/',s,bra)
      if slash=0 then do
          slash=lastpos('/',s)
          if slash>0 then bra=lastpos(' ',s,slash)
      end
      end
  else do
      slash=lastpos('/',s)
      if slash>0 then bra=lastpos(' ',s,slash)
      end
  if slash-bra=2 then s=left(s,bra)'00'substr(s,bra+1)
  if slash-bra=3 then s=left(s,bra)'0'substr(s,bra+1)
  subject.mc=s
  'GetMailInfo File'
  filename.mc=result
return

SortMessages:
/*
** A simple algorithm is fastest with relatively few items.
** There should be no need for something fancy like quicksort :-)
*/
  do i=2 to mc
     do j=1 to i-1
        if upper(subject.j)>upper(subject.i) then do/* let's swap stuff... */
        temp=subject.j
        subject.j=subject.i
        subject.i=temp
        temp=filename.j
        filename.j=filename.i
        filename.i=temp
        temp=part.j
        part.j=part.i
        part.i=temp
        end /* if */
     end /* do j */
  end /* do i */
return  /* Everything should be in order now... */